home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / html.tcl < prev    next >
Encoding:
Text File  |  1995-11-06  |  2.8 KB  |  100 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # go render a page.  We have to make sure we don't render one page while
  8. # still rendering the previous one.
  9.  
  10. set Help_history ""
  11. proc HMlink_callback {win {file history}} {
  12.     global Help_dir Help_history Help_message
  13.  
  14.     set fragment ""
  15.     regexp {([^#]*)#(.+)} $file dummy file fragment
  16.     if {$file == "" && $fragment != ""} {
  17.         HMgoto $win $fragment
  18.         return
  19.     }
  20.  
  21.     if {$file == "history"} {
  22.         if {[llength $Help_history] <2} {
  23.             set Help_message "Already at first page"
  24.             return
  25.         }
  26.         set file [lindex $Help_history 1]
  27.         set Help_history [lrange $Help_history 1 end]
  28.     } elseif {[lindex $Help_history 0] != $file} {
  29.         # puts "At: [lindex [$win yview] 0]"
  30.         set Help_history "$file $Help_history"
  31.     }
  32.  
  33.     HMreset_win $win
  34.     if {$fragment != ""} {
  35.         HMgoto $win $fragment
  36.     }
  37.     if {[catch {set fd [open $Help_dir/$file r]}]} {
  38.         set Help_message "Sorry, couldn't find help file $Help_dir/$file"
  39.         return
  40.     }
  41.     HMparse_html [read $fd] "HMrender $win"
  42.     HMset_state $win -stop 1        ;# stop rendering previous page if busy
  43.     close $fd
  44. }
  45.  
  46. # supply an image callback function
  47. # Read in an image if we don't already have one
  48. # callback to library for display
  49.  
  50. proc HMset_image {win handle src} {
  51.     global Help_dir Help_message
  52.     set image $Help_dir/$src
  53.     if {[string first " Image_$image " " [image names] "] >= 0} {
  54.         HMgot_image $handle Image_$image
  55.     } else {
  56.         set Help_message "fetching image $src"
  57.         update idletasks
  58.         global TRANSPARENT_GIF_COLOR
  59.         set TRANSPARENT_GIF_COLOR [$win cget -bg]
  60.         catch {image create photo Image_$image -file $image} image
  61.         HMgot_image $handle $image
  62.     }
  63. }
  64.  
  65. # Lets invent a new HTML tag, just for fun.
  66. # Change the color of the text. Use html tags of the form:
  67. # <color value=blue> ... </color>
  68. # We can invent a new tag for the display stack.  If it starts with "T"
  69. # it will automatically get mapped directly to a text widget tag.
  70.  
  71. proc HMtag_color {win param text} {
  72.     upvar #0 HM$win var
  73.     set value bad_color
  74.     HMextract_param $param value
  75.     $win tag configure $value -foreground $value
  76.     HMstack $win "" "Tcolor $value"
  77. }
  78.  
  79. proc HMtag_/color {win param text} {
  80.     upvar #0 HM$win var
  81.     set value bad_color
  82.     HMstack $win / "Tcolor {}"
  83. }
  84.  
  85. # downloading fonts can take a long time.  We'll override the default
  86. # font-setting routine to permit better user feedback on fonts.  We'll
  87. # keep our own list of installed fonts on the side, to guess when delays
  88. # are likely
  89.  
  90. proc HMset_font {win tag font} {
  91.     global Fonts Help_message
  92.     if {![info exists Fonts($font)]} {
  93.         set Fonts($font) 1
  94.         set Help_message "downloading font $font"
  95.         update idletasks
  96.     }
  97.     set Help_message ""
  98.     catch {$win tag configure $tag -font $font} message
  99. }
  100.